home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / misc / m2pica.lha / M2Picasso / Txt / picatest16.mod < prev    next >
Encoding:
Text File  |  1994-11-17  |  3.6 KB  |  135 lines
  1. (*******************************************************************************
  2.  : Program.         Picatest16.MOD
  3.  : Author.          Carsten Wartmann (Crazy Video)
  4.  : Address.         Wutzkyallee 83, 12353 Berlin
  5.  : Phone.           030/6614776
  6.  : Version.         0.99
  7.  : Date.            22.Feb.1994
  8.  : Copyright.       PD
  9.  : Language.        Modula-2
  10.  : Compiler.        M2Amiga V4.3d
  11.  : Contents.        15-Bit Demoprogramm.
  12. *******************************************************************************)
  13.  
  14. MODULE PicaTest16 ;
  15.  
  16.  
  17. FROM SYSTEM       IMPORT ADR,ADDRESS,TAG,SHIFT ;
  18.  
  19. FROM UtilityD     IMPORT tagEnd,tagDone ;
  20.  
  21. FROM Arts         IMPORT Assert ;
  22.  
  23. FROM ExecL        IMPORT Forbid,Permit ;
  24.  
  25. FROM DosL         IMPORT Delay ;
  26.  
  27. FROM GraphicsL    IMPORT SetRGB4 ;
  28.  
  29. FROM IntuitionD   IMPORT ScreenPtr ;
  30. FROM IntuitionL   IMPORT ScreenToFront ;
  31.  
  32. FROM RandomNumber IMPORT RND ;
  33.  
  34. FROM VilIntuiSupL IMPORT OpenVillageScreenTagList,CloseVillageScreen,
  35.                          LockVillageScreen,UnLockVillageScreen,
  36.                          VillageRectFill,VillageBlitCopy,WaitVillageBlit,
  37.                          VillageModeRequest ;
  38. FROM VilIntuiSupD IMPORT Set16BitPixel,Line16Bit,
  39.                          VilFillRecord,VilCopyRecord,VilScrCopy,VilScrAnd,VilDstInvert,
  40.                          TavisTags,InvalidID ;
  41.  
  42.  
  43.  
  44. VAR scr    : ScreenPtr ;
  45.     start  : ADDRESS ;
  46.     col    : LONGINT ;
  47.     mode   : LONGCARD ;
  48.     x,y,ok,
  49.     r,g,b  : LONGINT ;
  50.     tags   : ARRAY [0..40] OF LONGCARD ;
  51.     copy   : VilCopyRecord ;
  52.     fill   : VilFillRecord ;
  53.  
  54.  
  55.  
  56. BEGIN
  57.   mode := VillageModeRequest(TAG(tags,tavisMinDepth,  15,
  58.                                       tavisMaxDepth,  15,
  59.                                            tagDone)) ;
  60.   Assert(mode#InvalidID,ADR("Kein Screenmode gewählt !")) ;
  61.  
  62.   scr := OpenVillageScreenTagList(TAG(tags,tavisScreenModeID,  mode,
  63.                                            tagDone)) ;
  64.   Assert(scr#NIL,ADR("Kann PICASSO Screen nicht öffnen !")) ;
  65.  
  66.   start := LockVillageScreen(scr) ;
  67.  
  68.   FOR b:=0 TO 31 DO
  69.    FOR g:=0 TO 63 DO
  70.     FOR r:=0 TO 31 DO
  71.      Set16BitPixel(scr,r+(b MOD 8)*32,g+(b DIV 8)*64,r,g,b) ;
  72.     END ;
  73.    END ;
  74.   END ;
  75.  
  76.   UnLockVillageScreen(scr) ;
  77.  
  78.   Delay(3*50) ;
  79.  
  80.   FOR x:=0 TO 255 DO
  81.     Line16Bit(scr,RND(scr^.width),RND(scr^.height),
  82.                   RND(scr^.width),RND(scr^.height),RND(32),RND(64),RND(32)) ;
  83.   END ;
  84.  
  85.   Delay(3*50) ;
  86.  
  87.   Forbid() ;
  88.    ScreenToFront(scr) ;
  89.    start := LockVillageScreen(scr) ;
  90.   Permit() ;
  91.  
  92.   FOR y:=0 TO (scr^.height DIV 32) DO
  93.     FOR x:=0 TO (scr^.width DIV 32)-1 DO
  94.       copy.scrAdr   := ADDRESS(LONGINT(start) + (LONGINT(scr^.width) * (y*32) + x*32)*2) ;
  95.       copy.dstAdr   := ADDRESS(LONGINT(start) + (LONGINT(scr^.width)
  96.                                * RND(scr^.height DIV 32)*32 + RND(scr^.width DIV 32)*32)*2) ;
  97.       copy.scrPitch := scr^.width ;
  98.       copy.dstPitch := scr^.width ;
  99.       copy.width    := 32 ;
  100.       copy.height   := 32 ;
  101.       copy.rop      := VilScrCopy ;
  102.  
  103.       ok := VillageBlitCopy(scr,ADR(copy)) ;
  104.       WaitVillageBlit ;
  105.     END ;
  106.   END ;
  107.  
  108.   Delay(3*50) ;
  109.  
  110.   FOR y:=0 TO (scr^.height DIV 32) DO
  111.     FOR x:=0 TO (scr^.width DIV 32)-1 DO
  112.       fill.dstAdr   := ADDRESS(LONGINT(start) + (LONGINT(scr^.width)
  113.                                * RND(scr^.height DIV 32)*32 + RND(scr^.width DIV 32)*32)*2) ;
  114.       fill.dstPitch := scr^.width ;
  115.       fill.width    := 32 ;
  116.       fill.height   := 32 ;
  117.       fill.color    := RND(16777216) ; (* Merged RGB...*)
  118.  
  119.       ok := VillageRectFill(scr,ADR(fill)) ;
  120.       WaitVillageBlit ;
  121.     END ;
  122.   END ;
  123.  
  124.   UnLockVillageScreen(scr) ;
  125.  
  126.   Delay(5*50) ;
  127.  
  128. CLOSE
  129.   IF scr#NIL THEN
  130.     UnLockVillageScreen(scr) ;
  131.     CloseVillageScreen(scr) ;
  132.   END ;
  133.  
  134. END PicaTest16 .
  135.